
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% grammar predicates

tree(Node^Children:Type, Node, Type, Children).
node(Node^_:_, Node).
type(_:Type, Type).
children(_^Children:_, Children).
child(N, _^Children:_, Child) :-
        nth0(N, Children, Child).

linfun(Lang, Node, ChildrenCats, CFun, Cat, Seqs) :-
	Lang:lin(CFun, Seqs, Node),
	Lang:prod(Cat, CFun, ChildrenCats).

subtree([], Tree, Tree).
subtree([N|Path], Tree, Subtree) :-
        child(N, Tree, Child),
        subtree(Path, Child, Subtree).

replace_subtree([], Tree, Tree, NewTree, NewTree).
replace_subtree([N|Path], Tree, Subtree, NewTree, NewSubtree) :-
        tree(Tree, Node, Type, Children),
        replace_nth0(N, Children, Child, NewChildren, NewChild),
        tree(NewTree, Node, Type, NewChildren),
        replace_subtree(Path, Child, Subtree, NewChild, NewSubtree).

replace_nth0(N, [X|Xs], X0, [Y|Ys], Y0) :-
        ( N > 0 ->
          X = Y,
          N1 is N-1,
          replace_nth0(N1, Xs, X0, Ys, Y0)
        ; N == 0 ->
          X = X0, Xs = Ys, Y = Y0
        ).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% type checking

typecheck(Tree) :- typecheck(Tree, _).

typecheck(Tree, WantedType) :-
        tree(Tree, Fun, TreeType, Children),
        ( is_list(Children) ->
          ( fun(Fun, FunType, Childtypes) ->
            length(Children, N), length(Childtypes, M),
            ( FunType = WantedType, WantedType = TreeType, N = M ->
              typecheck_children(Children, Childtypes)
            ;
              throw(type_error(Fun:[wanted:WantedType, function:FunType, given:TreeType, children:N=M]))
            )
          ; 
            throw(type_error(Fun:notfound))
          )
        ;
          throw(type_error(Fun:[notlist:Children]))
        ).

typecheck_children([], []).
typecheck_children([Child|Children], [Type|Types]) :-
        typecheck(Child, Type),
        typecheck_children(Children, Types).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% random generation

genrand(Type, Tree, Depth) :-
        Depth1 is Depth - 1,
        Depth1 >= 0,
        tree(Tree, Fun, Type, Children),
        findall(Fun-Argtypes, fun(Fun, Type, Argtypes), Funs),
        random_permutation(Funs, RFuns),
        member(Fun-Argtypes, RFuns),
        genrand_children(Argtypes, Children, Depth1).

genrand_children([], [], _).
genrand_children([Type|Types], [Tree|Trees], Depth) :-
        genrand(Type, Tree, Depth),
        genrand_children(Types, Trees, Depth).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% linearisation

linearise(Lang, Tree, Lin) :-
	linearise_with_path(Lang, Tree, [], [Lin|_], _Cat).

linearise_with_path(Lang, Tree, Path, Lin, Cat) :-
	tree(Tree, Node, _Type, Children),
	linearise_children_with_path(Children, Lang, Path, 0, ChildLins, ChildCats),
	linfun(Lang, Node, ChildCats, _CFun, Cat, Seqs),
	findall(Phr,
		( member(Seqnr, Seqs),
                  Lang:seq(Seqnr, Seq),
		  map_sequence(Seq, ChildLins, Path, Phr, [])
		), Lin).

linearise_children_with_path([], _, _, _, [], []).
linearise_children_with_path([Tree|Trees], Lang, Path, N, [Lin|Lins], [CoercedCat|Cats]) :-
	linearise_with_path(Lang, Tree, [N|Path], Lin, Cat),
	M is N+1,
	linearise_children_with_path(Trees, Lang, Path, M, Lins, Cats),
	( Cat = CoercedCat
        ; Lang:coerce(CoercedCat, Cat)
        ).

map_sequence([], _Lins, _Path) --> [].
map_sequence([Arg | Seq], Lins, Path) --> 
	map_sequence_arg(Arg, Lins, Path),
	map_sequence(Seq, Lins, Path).

map_sequence_arg(cat(Arg,Ix), Lins, _Path) -->
	!, {nth0(Arg, Lins, Lin),
	    ( nth0(Ix, Lin, Phr) -> true ; Phr = [Lin] )
           },
	Phr.
map_sequence_arg(Word, _ArgLins, Path) -->
	{reverse(Path, RPath)},
	[Word/RPath].


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% lin preds

yield(Lin, Path, Yield) :-
        findall(N:Word/WPath, (nth0(N, Lin, Word/WPath), append(Path, _, WPath)), Yield).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% pretty-printing

print_tree(Tree) :- print_tree(Tree, -).

print_tree(Tree, Path) :-
        tree(Tree, Fun, Type, Children),
        ( Path == [] -> write('*(')
        %% ; Path == [0] -> write('(*')
        ; write('(') ),
        ( var(Fun) ->
          write(?), write(Type)
        ;
          write(Fun:Type), 
          print_tree_children(Children, Path, 0)
        ),
        write(')').

print_tree_children([], _, _).
print_tree_children([Child|Children], NPath, N) :-
	( NPath = [N|Path] -> true ; Path = - ),
        write(' '),
	print_tree(Child, Path),
	M is N+1,
	print_tree_children(Children, NPath, M).


print_lin(Lin) :- print_lin(Lin, -).
print_lin(Lin, Path) :- print_lin_phrase(Lin, Path).

% print_lin([], _).
% print_lin([Phr|Lin], NPath) :-
% 	print_lin_phrase(Phr, NPath),
% 	print_if_empty(Lin, '', ', '),
% 	print_lin(Lin, NPath).

print_lin_phrase([], _).
print_lin_phrase([Ix:Word/Path | Phr], NPath) :-
        !, print_lin_phrase([(Ix:Word)/Path | Phr], NPath).
print_lin_phrase([Word/Path | Phr], NPath) :-
	!, ( append(NPath, _, Path) -> write('*') ; true ),
	write(Word), write('/'), print_path(Path),
	print_if_empty(Phr, '', ' '),
	print_lin_phrase(Phr, NPath).
print_lin_phrase([Word | Phr], NPath) :-
	write(Word),
	print_if_empty(Phr, '', ' '),
	print_lin_phrase(Phr, NPath).

print_path(-) :- write(-).
print_path([]).
print_path([N|Path]) :- write(N), print_path(Path).

print_if_empty([], T, _) :- !, write(T).
print_if_empty(_,  _, F) :- write(F).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% utilities

countall(Goal, N) :-
	flag(ctr, Old, 0),
	( Goal,
	  flag(ctr, M, M+1),
	  fail
	; true ),
	flag(ctr, N, Old).



